home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0161_Just a little GFX TPU....pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  3KB  |  138 lines
  1.  Unit Graphic;
  2.  Interface
  3.  Var ScrBase : Word;
  4.    Procedure VideoMode ( Mode : Byte );
  5.    Procedure SetColor ( Color, Red, Green, Blue : Byte );
  6.    Procedure Pset(X,Y,C : Word);
  7.    Procedure SetRGBDAC(Color,R,G,B : Byte);
  8.    Procedure WaitRetrace;
  9.    Function Rad (theta : real) : real;
  10.    Procedure PutPix(x, y : Word; Color : Byte);
  11.    Procedure ScrPan(ScrOfs : Word);
  12.    Procedure SetModeX;
  13.  implementation
  14.      Procedure WaitRetrace; Assembler;
  15.        Asm
  16.          mov     dx,3dah
  17.  @L1:
  18.          in      al,dx
  19.          test    al,08h
  20.          jne     @L1
  21.  @L2:
  22.          in      al,dx
  23.          test    al,08h
  24.          je      @L2
  25.        End;
  26.  
  27.      Procedure SetModeX; Assembler;
  28.        Asm
  29.          mov     ax,0012h
  30.          int     10h
  31.          mov     ax,0013h
  32.          int     10h
  33.          mov     dx,3c4h
  34.          mov     ax,0604h
  35.          out     dx,ax
  36.          mov     dx,3d4h
  37.          mov     ax,0014h
  38.          out     dx,ax
  39.          mov     ax,0e317h
  40.          out     dx,ax
  41.        End;
  42.  
  43.          Procedure ScrPan(ScrOfs : Word); Assembler;
  44.          Asm
  45.          mov     bx,ScrOfs
  46.          mov     dx,3d4h
  47.          mov     ah,bh
  48.          mov     al,0ch
  49.          out     dx,ax
  50.          mov     ah,bl
  51.          inc     al
  52.          out     dx,ax
  53.        End;
  54.  
  55.      Procedure PutPix(x, y : Word; Color : Byte); Assembler;
  56.        Asm
  57.          mov     ax,0a000h
  58.          mov     es,ax
  59.          mov     bx,x
  60.          mov     dx,3c4h
  61.          mov     ax,0102h
  62.          mov     cl,bl
  63.          and     cl,3
  64.          shl     ah,cl
  65.          out     dx,ax
  66.          mov     ax,y
  67.          shl     ax,4
  68.          mov     di,ax
  69.          shl     ax,2
  70.          add     di,ax
  71.          shr     bx,2
  72.          add     di,bx
  73.          add     di,ScrBase
  74.          mov     al,Color
  75.          mov     es:[di],al
  76.        End;
  77.  
  78.  
  79.  
  80.    Procedure VideoMode ( Mode : Byte );
  81.  
  82.      Begin { VideoMode }
  83.        Asm
  84.          Mov  AH,00
  85.          Mov  AL,Mode
  86.          Int  10h
  87.        End;
  88.      End;  { VideoMode }
  89.  
  90.  Procedure SetRGBDAC(Color,R,G,B : Byte);
  91.  Begin
  92.  Asm
  93.  Mov AH,$10;
  94.  Mov AL,$10;
  95.  mov BL,Color;
  96.  Mov CH,G;
  97.  Mov CL,B;
  98.  Mov DH,R;
  99.  Int $10;
  100.  End;
  101.  End;
  102.  
  103.  
  104.    Procedure SetColor ( Color, Red, Green, Blue : Byte );
  105.      Begin { SetColor }
  106.        Port[$3C8] := Color;
  107.        Port[$3C9] := Red;
  108.        Port[$3C9] := Green;
  109.        Port[$3C9] := Blue;
  110.      End;  { SetColor }
  111.  
  112.  procedure Pset(X,Y,C : Word);
  113.  begin
  114.  Mem[$0A000:Y*320+X] := C;
  115.  end;
  116.  Function rad (theta : real) : real;
  117.    {  This calculates the degrees of an angle }
  118.  BEGIN
  119.    rad := theta * pi / 180
  120.  END;
  121.  
  122.  End.
  123.  
  124. Try that I'm sure you can figure it out ..:) .. B4 you use SCRPAN you
  125. have to do SETMODEX ... I think PutPix is faster then PSET not srue ..
  126. you could benchmark it ... VIDEOMODE($13); gets you into 320x200x256 grf
  127. mode ... Tell me what ya think .. this is COMPLETELY free but you might
  128. want to tell me what ya think?
  129. Thanks!
  130. Cya!
  131. ███████████████████████████████████████
  132. █     Chris Austin - CEO IdeaSoft     █▒
  133. █           SysOp IdeaSoft/2          █▒
  134. █            (609) 884-2717           █▒
  135. █ FidoNet 1:2623/56 : CD-ROM : Doors! █▒
  136. ███████████████████████████████████████▒
  137.  ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  138.